home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / Moose / Object.pm < prev    next >
Encoding:
Perl POD Document  |  2010-07-25  |  5.8 KB  |  228 lines

  1.  
  2. package Moose::Object;
  3.  
  4. use strict;
  5. use warnings;
  6.  
  7. use Devel::GlobalDestruction ();
  8. use MRO::Compat ();
  9. use Scalar::Util ();
  10. use Try::Tiny ();
  11.  
  12. use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
  13. use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
  14.  
  15. our $VERSION   = '1.09';
  16. $VERSION = eval $VERSION;
  17. our $AUTHORITY = 'cpan:STEVAN';
  18.  
  19. sub new {
  20.     my $class = shift;
  21.     my $real_class = Scalar::Util::blessed($class) || $class;
  22.  
  23.     my $params = $real_class->BUILDARGS(@_);
  24.  
  25.     return Class::MOP::Class->initialize($real_class)->new_object($params);
  26. }
  27.  
  28. sub BUILDARGS {
  29.     my $class = shift;
  30.     if ( scalar @_ == 1 ) {
  31.         unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
  32.             Class::MOP::class_of($class)->throw_error(
  33.                 "Single parameters to new() must be a HASH ref",
  34.                 data => $_[0] );
  35.         }
  36.         return { %{ $_[0] } };
  37.     }
  38.     else {
  39.         return {@_};
  40.     }
  41. }
  42.  
  43. sub BUILDALL {
  44.     # NOTE: we ask Perl if we even
  45.     # need to do this first, to avoid
  46.     # extra meta level calls
  47.     return unless $_[0]->can('BUILD');
  48.     my ($self, $params) = @_;
  49.     foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) {
  50.         $method->{code}->execute($self, $params);
  51.     }
  52. }
  53.  
  54. sub DEMOLISHALL {
  55.     my $self = shift;
  56.     my ($in_global_destruction) = @_;
  57.  
  58.     # NOTE: we ask Perl if we even
  59.     # need to do this first, to avoid
  60.     # extra meta level calls
  61.     return unless $self->can('DEMOLISH');
  62.  
  63.     my @isa;
  64.     if ( my $meta = Class::MOP::class_of($self ) ) {
  65.         @isa = $meta->linearized_isa;
  66.     } else {
  67.         # We cannot count on being able to retrieve a previously made
  68.         # metaclass, _or_ being able to make a new one during global
  69.         # destruction. However, we should still be able to use mro at
  70.         # that time (at least tests suggest so ;)
  71.         my $class_name = ref $self;
  72.         @isa = @{ mro::get_linear_isa($class_name) }
  73.     }
  74.  
  75.     foreach my $class (@isa) {
  76.         no strict 'refs';
  77.         my $demolish = *{"${class}::DEMOLISH"}{CODE};
  78.         $self->$demolish($in_global_destruction)
  79.             if defined $demolish;
  80.     }
  81. }
  82.  
  83. sub DESTROY {
  84.     my $self = shift;
  85.  
  86.     local $?;
  87.  
  88.     Try::Tiny::try {
  89.         $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
  90.     }
  91.     Try::Tiny::catch {
  92.         # Without this, Perl will warn "\t(in cleanup)$@" because of some
  93.         # bizarre fucked-up logic deep in the internals.
  94.         no warnings 'misc';
  95.         die $_;
  96.     };
  97.  
  98.     return;
  99. }
  100.  
  101. # support for UNIVERSAL::DOES ...
  102. BEGIN {
  103.     my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa";
  104.     eval 'sub DOES {
  105.         my ( $self, $class_or_role_name ) = @_;
  106.         return $self->'.$does.'($class_or_role_name)
  107.             || $self->does($class_or_role_name);
  108.     }';
  109. }
  110.  
  111. # new does() methods will be created
  112. # as appropiate see Moose::Meta::Role
  113. sub does {
  114.     my ($self, $role_name) = @_;
  115.     my $meta = Class::MOP::class_of($self);
  116.     (defined $role_name)
  117.         || $meta->throw_error("You must supply a role name to does()");
  118.     return 1 if $meta->can('does_role') && $meta->does_role($role_name);
  119.     return 0;
  120. }
  121.  
  122. sub dump {
  123.     my $self = shift;
  124.     require Data::Dumper;
  125.     local $Data::Dumper::Maxdepth = shift if @_;
  126.     Data::Dumper::Dumper $self;
  127. }
  128.  
  129. 1;
  130.  
  131. __END__
  132.  
  133. =pod
  134.  
  135. =head1 NAME
  136.  
  137. Moose::Object - The base object for Moose
  138.  
  139. =head1 DESCRIPTION
  140.  
  141. This class is the default base class for all Moose-using classes. When
  142. you C<use Moose> in this class, your class will inherit from this
  143. class.
  144.  
  145. It provides a default constructor and destructor, which run the
  146. C<BUILDALL> and C<DEMOLISHALL> methods respectively.
  147.  
  148. You don't actually I<need> to inherit from this in order to use Moose,
  149. but it makes it easier to take advantage of all of Moose's features.
  150.  
  151. =head1 METHODS
  152.  
  153. =over 4
  154.  
  155. =item B<< Moose::Object->new(%params) >>
  156.  
  157. This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
  158. instance of the appropriate class. Once the instance is created, it
  159. calls C<< $instance->BUILDALL($params) >>.
  160.  
  161. =item B<< Moose::Object->BUILDARGS(%params) >>
  162.  
  163. The default implementation of this method accepts a hash or hash
  164. reference of named parameters. If it receives a single argument that
  165. I<isn't> a hash reference it throws an error.
  166.  
  167. You can override this method in your class to handle other types of
  168. options passed to the constructor.
  169.  
  170. This method should always return a hash reference of named options.
  171.  
  172. =item B<< $object->BUILDALL($params) >>
  173.  
  174. This method will call every C<BUILD> method in the inheritance
  175. hierarchy, starting with the most distant parent class and ending with
  176. the object's class.
  177.  
  178. The C<BUILD> method will be passed the hash reference returned by
  179. C<BUILDARGS>.
  180.  
  181. =item B<< $object->DEMOLISHALL >>
  182.  
  183. This will call every C<DEMOLISH> method in the inheritance hierarchy,
  184. starting with the object's class and ending with the most distant
  185. parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean
  186. indicating whether or not we are currently in global destruction.
  187.  
  188. =item B<< $object->does($role_name) >>
  189.  
  190. This returns true if the object does the given role.
  191.  
  192. =item B<DOES ($class_or_role_name)>
  193.  
  194. This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
  195.  
  196. This is effectively the same as writing:
  197.  
  198.   $object->does($name) || $object->isa($name)
  199.  
  200. This method will work with Perl 5.8, which did not implement
  201. C<UNIVERSAL::DOES>.
  202.  
  203. =item B<< $object->dump($maxdepth) >>
  204.  
  205. This is a handy utility for C<Data::Dumper>ing an object. By default,
  206. the maximum depth is 1, to avoid making a mess.
  207.  
  208. =back
  209.  
  210. =head1 BUGS
  211.  
  212. See L<Moose/BUGS> for details on reporting bugs.
  213.  
  214. =head1 AUTHOR
  215.  
  216. Stevan Little E<lt>stevan@iinteractive.comE<gt>
  217.  
  218. =head1 COPYRIGHT AND LICENSE
  219.  
  220. Copyright 2006-2010 by Infinity Interactive, Inc.
  221.  
  222. L<http://www.iinteractive.com>
  223.  
  224. This library is free software; you can redistribute it and/or modify
  225. it under the same terms as Perl itself.
  226.  
  227. =cut
  228.